home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / gw15pak.arc / GWTERM10.ARC / SOURCE.ARC / GWTERM.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-18  |  7KB  |  210 lines
  1. PROGRAM GWTerm;
  2. {Written by Joel Bergen, ProVision BBS 206-353-6966 12/14/89
  3.  This software is Public Domain, however donations are greatly appreciated.
  4.  
  5. GWTerm protocol definition:
  6.  
  7.   Global War sends "ESC GWEnq" and waits approx 1/4 second for a
  8.   response from GWTerm.  If the response is not received, Global War
  9.   assumes the player is not using GWTerm and will send ANSI maps.
  10.  
  11.   GWTerm responds with "ACK REV"
  12.  
  13.   Global War compares REV with the current rev level it supports.
  14.   If REV is acceptable, Global War will reply with an "ACK" otherwise
  15.   it will send a "NAK".
  16.  
  17.   GWTerm, if it does not receive an ACK, will notify the user by displaying
  18.   the message "This copy of GWTerm is obsolete"
  19.  
  20.   Global War will send codes to tell GWTerm to display maps as follows:
  21.       "ESC M 1"  display map of the Globe
  22.       "ESC M 2"  display map of Africa
  23.       "ESC M 3"  display map of Asia
  24.       "ESC M 4"  display map of Australia
  25.       "ESC M 5"  display map of Europe
  26.       "ESC M 6"  display map of N. America
  27.       "ESC M 7"  display map of S. America
  28.   How GWTerm goes about displaying these maps is entirely optional.  In this
  29.   version, screen dumps are stored in WAR.IMG and are read and block moved
  30.   onto the screen RAM.  Graphics mode could also be used.  The main
  31.   consideration is that country names, menus, and other data will be sent
  32.   and must be printed on top of these maps at specified screen coordinates
  33.   specified using ANSI codes.
  34.  
  35.   Global War will send "ESC Q" when the player exits the game to tell
  36.   GWTerm to terminate and exit back to the terminal program (Telix, etc)
  37.  
  38.   It should be fairly easy to port GWTerm over to other computers besides the
  39.   IBM PC, even if they don't support ANSI graphics or the IBM character set.
  40.   If you are successful in porting GWTerm, please upload your new version to
  41.   ProVision.
  42. }
  43.  
  44. USES
  45.   DOS, CRT, Async, Mouse4, ANSI;
  46. TYPE
  47.   ScreenType = ARRAY [1..4000] OF BYTE;
  48. CONST
  49.   Version= '1.0';
  50.   REV    = 'B';      {revision code, for compatibility checking}
  51.   ESC    = Chr(27);
  52.   ACK    = Chr(6);
  53.   AltX   = Chr(45);
  54.   GWEnq  = Chr(255);
  55.   Alpha  = ['A'..'Z','0'..'9','a'..'z','.',':'];
  56. VAR
  57.   ScreenColor       : ScreenType ABSOLUTE $B800:0000;  {color}
  58.   ScreenMono        : ScreenType ABSOLUTE $B000:0000;  {monochrome}
  59.   buf               : ScreenType;
  60.   Color,Local,Done  : BOOLEAN;
  61.   c,ch              : CHAR;
  62.   ComPort,BaudRate,
  63.   x,y,w,result      : WORD;
  64.   Regs              : Registers;
  65.   f                 : FILE;
  66.   i                 : INTEGER;
  67.   s                 : String;
  68.  
  69. PROCEDURE ExitProgram;
  70. BEGIN
  71.   Async_Close;    {close comm port}
  72.   Close(f);       {war.img}
  73.   RestoreMouseXy; {give whole screen back to mouse }
  74.   HideMouse;      {Hide mouse cursor }
  75.   Writeln('GWTerm exited.');
  76.   Halt;
  77. END;
  78.  
  79. FUNCTION ScreenChar(x,y:word) : Char;
  80. {mouse routine: returns character on screen at row x, column y}
  81. BEGIN
  82.   IF Color THEN
  83.     ScreenChar:=CHR(ScreenColor[((y-1)*80+x)*2-1])
  84.   ELSE
  85.     ScreenChar:=CHR(ScreenMono[((y-1)*80+x)*2-1]);
  86. END;
  87.  
  88. FUNCTION MouseWord(x,y,len : WORD) : String;
  89. {mouse routine: gets a word pointed to by the mouse. For reading country
  90.  names, menu items, etc}
  91. VAR
  92.   s : String;
  93.   i : Word;
  94. BEGIN
  95.   s:='';
  96.   IF ScreenChar(x,y) IN Alpha THEN BEGIN
  97.     WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  98.       Dec(x);
  99.     IF (x>0) AND (ScreenChar(x,y)=' ') AND (ScreenChar(x-1,y) IN Alpha)
  100.     THEN BEGIN
  101.       Dec(x);
  102.       WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  103.         Dec(x);
  104.     END;
  105.     Inc(x);
  106.     FOR i:=1 TO len DO BEGIN
  107.       s:=s+ScreenChar(x,y);
  108.       Inc(x);
  109.     END;
  110.   END;
  111.   MouseWord:=s;
  112. END;
  113.  
  114. BEGIN
  115.   Assign(f,FExpand(FSearch('WAR.IMG',GetEnv('PATH'))));
  116.   w:=IOresult;
  117.   {$I-} Reset(f,1); {$I+}
  118.   IF IOresult<>0 THEN BEGIN
  119.     Writeln('WAR.IMG not found!');
  120.     Halt;
  121.   END;
  122.   Val(ParamStr(1),ComPort,result);
  123.   Val(ParamStr(2),BaudRate,result);
  124.   IF (ComPort<1) OR (ComPort>4) OR
  125.      (BaudRate<300) OR (BaudRate>38400) THEN BEGIN
  126.     Writeln('Calling convention:  GWTERM ComPort BaudRate');
  127.     Close(f);
  128.     Halt;
  129.   END;
  130.   Regs.AH := $0F;    {Find out if they have color or mono}
  131.   Intr($10,Regs);
  132.   IF Regs.AL=7 THEN
  133.     Color:=FALSE
  134.   ELSE
  135.     Color:=TRUE;
  136.   Async_Init;
  137.   Done := NOT Async_Open(ComPort,BaudRate);
  138.   Writeln('GWTerm version ',Version,' active.  Alt-X to exit.');
  139.   IF Mouse_Installed THEN ShowMouse;
  140.   WHILE NOT Done DO BEGIN
  141.     REPEAT
  142.       c:=#00;
  143.       IF Async_Buffer_Check THEN BEGIN
  144.         c:=Async_Read;
  145.         Local:=FALSE;
  146.       END ELSE IF KeyPressed THEN BEGIN
  147.         ch:=ReadKey;
  148.         Local:=TRUE;
  149.         IF ch<>#0 THEN
  150.           Async_Send(ch)
  151.         ELSE BEGIN
  152.           ch:=ReadKey;   {They pressed a function key or other special key}
  153.           IF ch=AltX THEN ExitProgram; {alt-x forces termination}
  154.         END;
  155.       END ELSE IF Mouse_Installed AND (MousePosition(x,y)>0) THEN BEGIN
  156.         s:=MouseWord(x,y,5);
  157.         c:=s[1];
  158.         IF s<>''THEN BEGIN
  159.           IF S[2]=':' THEN
  160.             Async_Send(c)
  161.           ELSE BEGIN
  162.             FOR i:=1 TO 5 DO
  163.               Async_Send(s[i]);
  164.             Async_Send(#13);
  165.           END;
  166.         END;
  167.         REPEAT UNTIL MousePosition(x,y)=0; {wait till they let go of button}
  168.         c:=#00;
  169.       END;
  170.     UNTIL c<>#00;
  171.     IF Mouse_Installed THEN HideMouse;
  172.     IF (c=ESC) AND (NOT Local) THEN BEGIN
  173.       REPEAT UNTIL Async_Buffer_Check;
  174.       c:=Async_Read;
  175.       CASE c OF
  176.       GWEnq:BEGIN
  177.               Async_Send(ACK);
  178.               Async_Send(REV);                 {ver supported}
  179.               REPEAT UNTIL Async_Buffer_Check; {wait for the ok}
  180.               c:=Async_Read;
  181.               IF c<>ACK THEN BEGIN
  182.                 Writeln('This copy of GWTerm is OBSOLETE!'^G);
  183.                 Delay(5000); {give chance to read before screen clears}
  184.               END;
  185.             END;
  186.         'M':BEGIN
  187.               REPEAT UNTIL Async_Buffer_Check;
  188.               c:=Async_Read;
  189.               i:=ORD(c) - ORD('1');
  190.               IF (i>=0) AND (i < (FileSize(f) DIV 4000)) THEN BEGIN
  191.                 Seek(f,i*4000);
  192.                 BlockRead(f,buf,4000);
  193.                 IF Color THEN
  194.                   Move(buf,ScreenColor,4000)
  195.                 ELSE
  196.                   Move(buf,ScreenMono,4000);
  197.               END;
  198.             END;
  199.         'Q':Done := TRUE;
  200.         ELSE BEGIN
  201.           Display_ANSI(ESC);
  202.           Display_ANSI(c);
  203.         END;
  204.       END;
  205.     END ELSE Display_ANSI(c);
  206.     IF Mouse_Installed THEN ShowMouse;
  207.   END; {while not done}
  208.   ExitProgram;
  209. END.
  210.